VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Rectangles"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'*************************************************************************
'  This source code is provided "as is" and as an unsupported sample of
'  a Microsoft Visual Basic application that incorporates the MapPoint 2002
'  object model and ActiveX control. It can only  be used in accordance with
'  the terms and conditions of the Microsoft MapPoint 2002 and
'  Microsoft Visual Basic End User License Agreements.
'*************************************************************************

Private m_cRectangles As Collection

Public Sub Add(oRectangle As SpatialDataImport.Rectangle, Optional vIndexKey As Variant)
    
    If IsEmpty(vIndexKey) = True Then
        m_cRectangles.Add oRectangle
    Else
        m_cRectangles.Add oRectangle, vIndexKey
    End If
    
End Sub

Public Property Get Count() As Long
    Count = m_cRectangles.Count
End Property

Public Property Get Item(vIndexKey As Variant) As SpatialDataImport.Rectangle
Attribute Item.VB_UserMemId = 0
    Dim oRectangle As SpatialDataImport.Rectangle
On Error Resume Next
    Set oRectangle = m_cRectangles(vIndexKey)
    If oRectangle Is Nothing Then
        Set Item = Nothing
    Else
        Set Item = oRectangle
    End If
End Property

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = m_cRectangles.[_NewEnum]
End Property

Public Sub Remove(vIndexKey As Variant)
On Error Resume Next
    m_cRectangles.Remove vIndexKey
End Sub

Private Sub Class_Initialize()
    Set m_cRectangles = New Collection
End Sub

Public Sub RenderShapes(omMap As MapPoint.Map)
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Generates Shape objects for each Rectangle object in the collection.
    ' Assumptions:
    ' Notes:
'**********************************************************************************

    Dim oRectangle As SpatialDataImport.Rectangle
    Dim omLocArray() As MapPoint.Location
    Dim omLocation As MapPoint.Location
    Dim lRectangleCount As Long
    Dim lArrayIndex As Long
    Dim cShapes As Collection
    Dim omShape As MapPoint.Shape
    
    On Error GoTo errorHandler
    
    'Make sure we have at least one Rectangle.
    lRectangleCount = m_cRectangles.Count
    If lRectangleCount <> 0 Then
    
        'Initialize a collection to hold all of the generated shapes.
        'We'll use this to paint all the shapes.
        Set cShapes = New Collection
        
        'Loop through all the Rectangle objects.
        For Each oRectangle In m_cRectangles
        
            'Generate a Shape object and a Location for this Rectangle.
            Set omLocation = oRectangle.RenderShape(omMap, omShape)
            
            'Make sure we got a location.  If so, then add it to our Location array.
            If Not omLocation Is Nothing Then
                
                'Add the returned Shape object to our collection.
                cShapes.Add omShape
                
                'Re-Dimension our Location array to make room for the new Location.
                lArrayIndex = lArrayIndex + 1
                ReDim Preserve omLocArray(1 To lArrayIndex)
                
                'Add the returned Location to our Location array.
                Set omLocArray(lArrayIndex) = omLocation
            
            End If
            
        Next oRectangle
    
        'Create a union of all of the created Rectangles, and set the map view
        'to show all of them.
        Set omLocation = omMap.Union(omLocArray)
        omLocation.GoTo
        
        'Paint the shapes.
        PaintShapes cShapes
        
    End If
    
    Exit Sub
errorHandler:
    MsgBox "Error in RenderShapes" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Sub
